Program kursovik;
Uses crt;
Const seg=$B800;
Type
   base=record
   n:integer;
   auth:string;
   name:string;
   year:integer;
   izd:string;
   ekzem:integer;
   end;
  f=file of base;
Var
 a:string;
 f1,f2,f3:f;
 c,q:char;
 bibl:base;
 n1:integer;

Procedure menu; forward;
Procedure cornum(var n1:integer);forward;
Procedure viewfile(var f3:f);forward;
Procedure delrec; forward;
Procedure insrec; forward;
Procedure correc; forward;
Procedure unicbook; forward;
Procedure report; forward;
Procedure inrec(var lib:base); forward;

Procedure newfile;
Var bibl:base;
    f1:f;
    auth1:string;
    n1:integer;
Begin
  clrscr;
  writeln('   ');
  readln(a);
  assign(f1,a);
 {$I-}
 reset(f1);
 {$I+}
 if ioresult=0 then
     begin
       writeln('T   ,      Enter');
       readln;
     end
  else
   begin
   {$I-}
    rewrite(f1);
   {$I+}
 if ioresult=0 then
 begin
  while c<>#27 do
  begin
   inrec(bibl);
   write(f1,bibl);
   writeln('   Enter   Esc');
   c:=readkey;
  end;
  close(f1);
  menu;
  end
  else
   begin
   repeat
   clrscr;
   write('  ,  ? y/n ');
   readln(q);
   if q='y' then newfile;
   if q='n' then menu;
   until (q='y')or(q='n');
   end;
   end;
End;

Procedure menu;
 Var x,y,i:word;
 Begin
  window(1,1,80,25);
  textbackground(0);
  clrscr;
  textbackground(14);
  clrscr;
  window(7,5,77,23);
  textbackground(0);
  clrscr;
  window(6,4,75,22);
  textbackground(1);
  textcolor($F);
  clrscr;
  gotoxy(30,3);
  write('==========');
  gotoxy(3,5);
  write(' ');
  gotoxy(3,7);
  write('   ');
  gotoxy(3,9);
  write('   ');
  gotoxy(3,11);
  write(' ');
  gotoxy(3,13);
  write('  ');
  gotoxy(3,15);
  write(' ');
  gotoxy(3,17);
  write('     ');
  gotoxy(23,19);
  write('   Esc');
   x:=4;
   y:=8;
   gotoxy(x,y);
    for i:=3 to 43 do
     mem[seg:((y-1)*80+(x-1+i))*2+1]:=$70;

    repeat
    c:=readkey;
     case c of
     #72:
    if y>9 then
     begin
      gotoxy(x,y);
       for i:=3 to 43 do
	mem[seg:((y-1)*80+(x-1+i))*2+1]:=$1f;
      y:=y-2;
      gotoxy(x,y);
       for i:=3 to 43 do
	mem[seg:((y-1)*80+(x-1+i))*2+1]:=$70;
      end;

      #80:
     if y<19 then
      begin
       gotoxy(x,y);
       for i:=3 to 43 do
	mem[seg:((y-1)*80+(x-1+i))*2+1]:=$1f;
       y:=y+2;
       gotoxy(x,y);
       for i:=3 to 43 do
	 mem[seg:((y-1)*80+(x-1+i))*2+1]:=$70;
       end;

      #13:
	  case y of
	  8:newfile;
	  10:delrec;
	  12:insrec;
	  14:correc;
	  16: begin
	   clrscr;
	writeln('  ,   ');
	readln(a);
	assign(f1,a);
      {$I-}
      reset(f1);
      {$I+}
      if ioresult=0 then viewfile(f1) else
    begin
     repeat
      clrscr;
      writeln('T   . X ? y/n');
      readln(q);
       if q='y' then viewfile(f1);
       if q='n' then menu;
     until (q='n') or (q='y');
    end;
   end;
	  18:unicbook;
	  20:report;
	  end;
 end;
  until c=#27;
halt;
end;



Procedure inrec(var lib:base);
Var
 errcode:integer;
 s:string;
 x,y:byte;
Begin
   window(1,1,80,24);
   clrscr;
   writeln('  :');
   writeln('  : ');
   cornum(n1);
   lib.n:=n1;
   writeln(' : ');
   readln(lib.auth);
   writeln(' : ');
   readln(lib.name);
   writeln('');
   readln(lib.izd);
   writeln(' : ');
    x:=wherex;
    y:=wherey;
    readln(s);
    val(s,n1,errcode);
    while (errcode<>0) or (n1<1900) or (n1>2004) do
     begin
      window(1,25,80,25);
      textbackground(10);
      clrscr;
      gotoxy(1,1);
      write('   !');
      window(1,1,80,24);
      textbackground(1);
      gotoxy(x,y);
      delline;
      textbackground(1);
      window(1,1,80,24);
      gotoxy(x,y);
      readln(s);
      val(s,n1,errcode);
     end;
     window(1,25,80,25);
      textbackground(10);
      clrscr;
     window(1,1,80,24);
      textbackground(1);
     gotoxy(x,y+1);
   lib.year:=n1;
   writeln(' ');
   cornum(n1);
   lib.ekzem:=n1;
  End;

Procedure cornum(var n1:integer);
Var errcode:integer;
    s:string;
    x,y:byte;
 begin
    x:=wherex;
    y:=wherey;
    readln(s);
    val(s,n1,errcode);
    while (errcode<>0) do
     begin
      window(1,25,80,25);
      textbackground(10);
      clrscr;
      gotoxy(1,1);
      write(' !');
      window(1,1,80,24);
      textbackground(1);
      gotoxy(x,y);
      delline;
      textbackground(1);
      window(1,1,80,24);
      gotoxy(x,y);
      readln(s);
      val(s,n1,errcode);
     end;
     window(1,25,80,25);
      textbackground(10);
      clrscr;
     window(1,1,80,24);
      textbackground(1);
     gotoxy(x,y+1);
     end;

Procedure delrec;
var k:byte;
    s:string;
    x,y:byte;
    errcode,n:integer;
begin
  clrscr;
  writeln('  ,   : ');
  readln(a);
  assign(f1,a);
   {$I-}
    reset(f1);
    assign(f2,'extra');
   {$I+}
    if ioresult=0 then
  begin
   rewrite(f2);
   k:=1;
   clrscr;
   writeln('     : ');
   while not eof(f1) do
    begin
     read(f1,bibl);
     writeln(k,'.', bibl.n,' ',bibl.name);
     k:=k+1;
    end;
    close(f1);
   if k-1=0 then
	      begin
	       writeln(' ,  Esc');
	       repeat
	       c:=readkey;
	       until c=#27;
	       menu
	       end
    else
   write(' ,     y/n?');
   repeat
   readln(q);
   if q='n' then menu;
   if q='y'then
    writeln('  ,   :');
   until (q='n') or (q='y');
     readln(s);
     val(s,n,errcode);
     x:=wherex;
     y:=wherey;
     while (errcode<>0) or (n>k-1) or (n<0) do
     begin
      write('   ',1,'  ',k-1,' !');
      gotoxy(x,y);
      gotoxy(x,y-1);
      delline;
      insline;
      gotoxy(x,y-1);
      readln(s);
      val(s,n,errcode);
     end;
    reset(f1);
    while f	ilepos(f1)<(n-1) do
     begin;
      read(f1,bibl);
      write(f2,bibl);
     end;
    seek(f1,n);
    while not eof(f1) do
     begin
      read(f1,bibl);
      write(f2,bibl);
     end;
    close(f2);
    reset(f2);
    rewrite(f1);
    while not eof(f2) do
     begin
      read(f2,bibl);
      write(f1,bibl);
     end;
     close(f1);
     close(f2);
     erase(f2);
     gotoxy(x,y+2);
    writeln(' ');
    gotoxy(1,21);
    textcolor(4);
    writeln('   Esc');
    repeat
     c:=readkey;
    until c=#27;
    menu;
   end;
end;

Procedure correc;
Var k,n:integer;
    n2,p,errcode:integer;
    pos,x,y:byte;
    s:string;
Begin
 clrscr;
 writeln('  ,     : ');
 readln(a);
  assign(f1,a);
      {$I-}
      reset(f1);
      {$I+}
      if ioresult=0 then
   begin
    k:=1;
   clrscr;
   writeln('     : ');
   while not eof(f1) do
    begin
     read(f1,bibl);
     writeln(k,'.', bibl.n,' ',bibl.name);
     k:=k+1;
    end;
    close(f1);
    writeln('      ?( ) ');
    readln(s);
     val(s,pos,errcode);
     x:=wherex;
     y:=wherey;
     while (errcode<>0) or (pos>k-1) or (pos<=0) do
     begin
     write('   ',1,'  ',k-1,' !');
     gotoxy(x,y-1);
     delline;
     insline;
     gotoxy(x,y-1);
     readln(s);
     val(s,pos,errcode);
     end;
    reset(f1);
    while not (eof(f1)) and (filepos(f1)<>pos) do read(f1,bibl);
    clrscr;
    writeln('  :');
    writeln('  ',bibl.n);
    writeln(' ');
    writeln('  ',bibl.auth);
    writeln(' ');
    writeln('  ',bibl.name);
    writeln(' ');
    writeln('  ',bibl.izd);
    writeln('  ');
    writeln('  ',bibl.year);
    writeln(' - ');
    writeln('  ',bibl.ekzem);
    gotoxy(1,18);
    write(':1-  2- 3- 4-- 5-  6--');
    gotoxy(1,13);
    writeln('    ?');
    p:=0;
     readln(s);
     val(s,p,errcode);
     x:=wherex;
     y:=wherey;
     while (errcode<>0) or (p>6) or (p<0) do
     begin
     write('   1  6!');
     gotoxy(x,y-1);
     delline;
     insline;
     gotoxy(x,y-1);
     readln(s);
     val(s,p,errcode);
     end;

     case p of
     1:
       begin
	clrscr;
	writeln('   ');
	cornum(n2);
	bibl.n:=n2;
       end;
     2:
      begin
	clrscr;
	writeln(' ');
	readln(bibl.auth);
       end;
      3:
      begin
	clrscr;
	writeln('   ');
	readln(bibl.name);
       end;
       4:
       begin
	clrscr;
	writeln(' ');
	readln(bibl.izd);
       end;
       5:
       begin
	clrscr;
	writeln('  ');
	readln(bibl.year);
       end;
       6:
       begin
	clrscr;
	writeln('  ');
	cornum(n2);
	bibl.ekzem:=n2;
       end;
       end;
     window(1,25,80,25);
     textbackground(10);
     clrscr;
     repeat
      write(' ? y/n ');
      readln(q);
     if q='n' then menu;
     if q='y' then
      begin
       seek(f1,filepos(f1)-1);
       write(f1,bibl);
       close(f1);
      end
     until (q='n') or (q='y');
     menu;
     end
    else
   repeat
 clrscr;
 writeln('      y/n');
 readln(q);
 if q='y' then correc;
 if q='n' then menu;
until (q='n') or (q='y');
End;

Procedure insrec;
Var
insbibl:base;
k,n2,errcode:integer;
s:string;
x,y:byte;

 Begin
 clrscr;
 writeln('  ,     : ');
  readln(a);
  assign(f1,a);
      {$I-}
      reset(f1);
      {$I+}
      if ioresult=0 then
   begin
    k:=1;
   clrscr;
   writeln('     : ');
   while not eof(f1) do
    begin
     read(f1,bibl);
     writeln(k,'.', bibl.n,' ',bibl.name);
     k:=k+1;
    end; {3}
    close(f1);
    assign(f2,'extra');
    write('      ?');
    readln(s);
    val(s,n2,errcode);
    x:=wherex;
    y:=wherey;
     while (n2>k-1) or (n2<0) or (errcode<>0) do
     begin
      write('   ',0,'  ',k-1);
      gotoxy(x,y-1);
      delline;
      insline;
      gotoxy(x,y-1);
      readln(s);
      val(s,n2,errcode);
     end;
    clrscr;
    inrec(insbibl);
   rewrite(f2);
   reset(f1);
   while filepos(f1)<n2 do
     begin
      read(f1,bibl);
      write(f2,bibl);
     end;
    write(f2,insbibl);
    seek(f1,n2+1);
    while not eof(f1) do
     begin
      read(f1,bibl);
      write(f2,bibl);
     end;
    close(f2);
    reset(f2);
    rewrite(f1);
    while not eof(f2) do
     begin
      read(f2,bibl);
      write(f1,bibl);
     end;
     close(f1);
     close(f2);
     erase(f2);
    writeln(' ');
    gotoxy(1,21);
    textcolor(4);
    writeln('   Esc');
    repeat
     c:=readkey;
    until c=#27;
    menu;
     end
  else
   repeat
    clrscr;
    writeln('      y/n');
    readln(q);
 if q='y' then insrec;
 if q='n' then menu;
until (q='n') or (q='y');
 End;

 Procedure viewfile(var f3:f);
Var k,size:byte;
  begin
       reset(f3);
       size:=filesize(f3);
       window(1,1,80,1);{}
       textbackground(0);
       clrscr;
       textcolor(15);{white}
       gotoxy(1,1);
       write('                                   -               -');
       window(1,2,80,24);{}
       textbackground(0);
       textcolor(15);
       clrscr;
	    if size<=11 then
		 begin
		 reset(f3);
		 while not eof(f3) do
		  begin
		  read(f3,bibl);
		   writeln(bibl.n:3,' ',bibl.auth:20,' ',bibl.name:24,' ',bibl.izd:14,' ',bibl.year:4,' ',bibl.ekzem:3);
		   writeln;
		  end;
		 window(1,25,80,25);{}
		 textbackground(7);
		 textcolor(4);
		 clrscr;
		 gotoxy(0,25);
	     end;
	    if size>11 then
		      begin
		    reset(f3);
		  for k:=1 to 11 do
		     begin
		       read(f3,bibl);
		       writeln(bibl.n:3,' ',bibl.auth:15,' ',bibl.name:24,' ',bibl.izd:14,' ',bibl.year:6,'   ',bibl.ekzem:7);
		       writeln('');
		     end;
		     end;
		 window(1,25,80,25);{}
		 textbackground(7);
		 textcolor(4);
		 clrscr;
		 gotoxy(0,25);
		 write('',chr(24),' ',chr(25),'     - Esc');
		k:=0;

		repeat
		       c:=readkey;
		       case c of
			    #80:
				begin
				  if eof(f3) then
				   begin  				      
      window(1,25,80,25);{}
				      textbackground(7);
				      textcolor(4);
				      clrscr;
				      gotoxy(1,25);
				      write(' ');
				   end;

				   if not eof(f3) then
				    begin
				      window(1,2,80,24);{}
				      textbackground(0);
				      textcolor(15);
				      clrscr;
				       for k:=1 to 11 do
					begin
					 read(f3,bibl);
					 writeln(bibl.n:3,' ',bibl.auth:15,' ',bibl.name:24,' ',bibl.izd:14,' ',bibl.year:6,'   ',bibl.ekzem:7);
					 writeln(' ');
					 if eof(f3) then break;
					end;
				    window(1,25,80,25);{}
				    textbackground(7);
				    textcolor(4);
				    clrscr;
				    gotoxy(1,25);
				    write(' ',chr(24),'  ',chr(25),'     - Esc');
				    end;
				    end;

			    #72: begin
				      if filepos(f3)<=11 then
				      begin
				       window(1,25,80,25);{}
				       textbackground(7);
				       textcolor(4);
				       clrscr;
				       gotoxy(1,25);
				       write(' ');
				      end
				      else
				       begin
					gotoxy(1,2);
					clrscr;
					if ((filepos(f3) mod 11)<>0) then seek(f3,filepos(f3)-(11+(filepos(f3) mod 11)))
					 else seek(f3,filepos(f3)-22);
					  window(1,2,80,24);{}
					  textbackground(0);
					  textcolor(15);
					  clrscr;
					for k:=1 to 11 do
					   begin
					    read(f3,bibl);
					    writeln(bibl.n:3,' ',bibl.auth:15,' ',bibl.name:24,' ',bibl.izd:14,' ',bibl.year:6,'   ',bibl.ekzem:7);
					    writeln;
					    end;
					    window(1,25,80,25);{}
					    textbackground(7);
					    textcolor(4);
					    clrscr;
					    gotoxy(0,25);
				      write(' ',chr(24),'  ',chr(25), '     - Esc');
				    end;
				 end;
				end;
		 until c=#27;
		 menu;
end;

Procedure unicbook;
Var f2:f;
Begin
 clrscr;
 writeln('  ,     : ');
  readln(a);
  assign(f1,a);
      {$I-}
      reset(f1);
      {$I+}
  assign(f2,'unic');
  rewrite(f2);
  while not eof(f1) do
   begin
   read(f1,bibl);
   if bibl.ekzem=1 then write(f2,bibl);
   end;
   close(f2);
   viewfile(f2);
  End;

Procedure report;
var f4:text;
Begin
  clrscr;
 writeln('  ,       : ');
  readln(a);
  assign(f1,a);
 assign(f4,'report.txt');
  {$I-}
  reset(f1);
  {$I+}
   rewrite(f4);
   while not eof(f1) do
   begin
   read(f1,bibl);
   writeln(f4,' ',bibl.name,'  ',bibl.ekzem-1);
   end;
   close(f4);
   clrscr;
   writeln('  ,    Esc');
   repeat
   c:=readkey;
   until c=#27;
   menu;
End;

Begin
 menu;
End.
